perm filename DRUM.F4[LX,LCS] blob
sn#164491 filedate 1975-06-13 generic text, type T, neo UTF8
C SETS UP 6 RHYTHMIC LISTS WHICH CAN BE CHOSEN AT RANDOM.
C LOAD THE LIST BY USING INST. '<DUMY'. EACH LIST MUST END WITH 2 NEGS.
SUBROUTINE SUBR
COMMON /INS/ INST(27),BG(60)
COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
DIMENSION A(7,30)
EQUIVALENCE (P2,P(2))
IF(INST(INUM).NE.'<DUMY')GO TO 100
XP=-1
K=CNT(INUM)
DO 40 J=1,7
40 A(J,K)=P(J+2)
C P3 GOES INT A(1, P4 → A(2, ETC.
C STORES 7 RHYTH LISTS.
RETURN
100 IF(CNT(INUM).EQ.1)KK=0
INST(INUM)='FM'
IF(IPAR.NE.2)GO TO 20
10 IF(KK.NE.0)GO TO 21
J=P2
RR=RAND(.7,1.2)
C RR IS SPEED FACTOR
REV=RAND(.08,.9)
FM=RAND(700.,900.)
FMX=RAND(5.,6.)
FREQ=RAND(-12.,15.)
21 KK=KK+1
22 P2=A(J,KK)*RR
DF=A(J,KK+1)
200 IF(P2.AND.DF)KK=0
IF(KK.GE.30)KK=0
DF=-.4
IF(P2)IREST=-1
C SO NOTE WILL NEVER BE LONGER THAN .4"
IF(XP.GE.P(1))RETURN
IF(P2)RETURN
X=RAND(-10.,20.)
IF(X)DF=.4/P2
Q=.4
IF(X.GT.0)Q=Q*P2
XP=P(1)+Q
C 1/3 OF THE NOTES ARE LOW AND LONG
RETURN
20 IF(DF.EQ.-.4)GO TO 31
P(3)=P(8)+X
C P8 WILL HAVE LOWNOTE FREQ.
INST(INUM)='FM2'
31 P(3)=P(3)+FREQ
IF(RR.LT..9)P(3)=P(3)/RR
P(8)=FM/P(3)
P(9)=P(3)*FMX/8.
IF(P(12))DF=P(12)
C USE P12 TO RESET DUTY FACT.
P(12)=REV
END